home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
advbas9b.zip
/
COMBLINE.BAS
< prev
next >
Wrap
BASIC Source File
|
1987-05-20
|
5KB
|
161 lines
10 CLEAR
CLS
OPTION BASE 1
DEFINT A-Z
DIM LN!(1001) ' handle 1,000 referenced lines, maximum
PRINT"Combline 1.3 -- Basic Utility to Combine Lines"
PRINT: PRINT
1010 PRINT
INPUT"File to combline (? for directory) ";FIL$
IF FIL$="" THEN END
IF FIL$="?" THEN FILES"*.BAS": GOTO 1010
T=INSTR(FIL$,".")
IF T THEN FIL$=LEFT$(FIL$,T) ELSE FIL$=FIL$+"."
CALL UPCASE(FIL$)
CALL EXIST(FIL$+"BAS"+CHR$(0),FILEXISTS)
IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"BAS": GOTO 1010
CALL EXIST(FIL$+"ASC"+CHR$(0),FILEXISTS)
IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"ASC": GOTO 1010
OPEN"I",1,FIL$+"BAS"
A$=INPUT$(1,1)
CLOSE
IF A$<>CHR$(255) THEN _
PRINT FIL$;"BAS is not a tokenized BASIC file.": GOTO 1010
OPEN"R",1,FIL$+"BAS"
FIELD 1,128 AS REC$
GET#1,1
A$=REC$
CLS
PRINT"CombLining BASIC file ";FIL$
PRINT: PRINT
PRINT"Scanning line";
1110 IF MID$(A$,2,2)=STRING$(2,0) THEN 1340 ' end of program
LN$=MID$(A$,4,2) ' get line number
LN!=CVI(LN$) ' calculate line number
A$=MID$(A$,6) ' skip line number
IF LN!<0 THEN LN!=LN!+65536! ' make line # unsigned
LOCATE 4,14
PRINT LN!;
1130 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
C=ASC(A$)
IF C=0 THEN 1110 ' end of line
IF C=14 THEN 1240 ' line number
IF C=34 THEN A$=MID$(A$,2): GOTO 1180 ' quotation mark
IF C=132 OR C=143 THEN A$=MID$(A$,2): GOTO 1200 ' DATA, REM
L=2 ' normal values
IF C=15 OR C>249 THEN L=3 _ ' byte, misc func/cmds
ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _ ' integer
ELSE IF C=29 THEN L=6 _ ' single precision
ELSE IF C=31 THEN L=10 ' double precision
A$=MID$(A$,L)
GOTO 1130
' scan to closing quotation mark or end of line is reached
1180 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
C=ASC(A$)
IF C=0 THEN 1110
A$=MID$(A$,2)
IF C=34 THEN 1130
GOTO 1180
' scan til end of line is reached
1200 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
C=ASC(A$)
IF C=0 THEN QUOT=0: GOTO 1110
L=2
IF C=34 THEN QUOT=NOT QUOT
IF QUOT THEN 1230
IF C=15 OR C>249 THEN L=3 _
ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _
ELSE IF C=29 THEN L=6 _
ELSE IF C=31 THEN L=10
1230 A$=MID$(A$,L)
GOTO 1200
' extract and save line number for cross reference
1240 LNR!=CVI(MID$(A$,2,2))
A$=MID$(A$,4)
IF LNR!<0 THEN LNR!=LNR!+65536!
GOSUB 1260
GOTO 1130
1260 IF LINS=0 THEN LINS=1: LN!(1)=LNR!: RETURN
GOSUB 1290
IF FOUND THEN RETURN
IF LINS>1000 THEN PRINT: PRINT"Too many lines referenced to handle": END
FOR X=LINS TO WH1 STEP -1
SWAP LN!(X),LN!(X+1)
NEXT
LN!(WH1)=LNR!
LINS=LINS+1
1290 FOUND=0
TOP=LINS+1
BOT=1
OLD=-1
WH1=LINS\2+1
LNF!=LN!(WH1)
WHILE OLD<>WH1 AND LNR!<>LNF!
IF LNR!<LNF! THEN TOP=WH1 ELSE BOT=WH1
OLD=WH1
WH1=(TOP+BOT)\2
LNF!=LN!(WH1)
WEND
IF LNR!=LNF! THEN FOUND=-1 ELSE IF LNR!>LNF! THEN WH1=WH1+1
RETURN
1340 CLOSE
PRINT: PRINT
PRINT"Primary analysis done, beginning secondary analysis and output."
LOCATE 8,1
PRINT"Scanning line";
FLAG=0
LN=1
OPEN"I",1,FIL$+"ASC"
OPEN"O",2,FIL$+"BCS"
WHILE NOT EOF(1) AND NOT FLAG
LINE INPUT#1,A$
L!=VAL(A$)
LOCATE 8,14
PRINT L!;
1510 IF L!=LN!(LN) THEN GOSUB 1620 _
ELSE IF L!<LN!(LN) THEN GOSUB 1600: GOTO 1530 _
ELSE LN=LN+1: IF LN>LINS THEN GOSUB 1600: FLAG=-1 ELSE 1510
LN=LN+1
IF LN>LINS THEN FLAG=-1
1530 WEND
WHILE NOT EOF(1)
LINE INPUT#1,A$
LOCATE 8,14
PRINT VAL(A$);
GOSUB 1600
WEND
IF LA$<>"" THEN GOSUB 1620
IF A$<>"" THEN LA$=A$: GOSUB 1620
CLOSE
PRINT: PRINT
PRINT"File comblined:";BYT;"bytes saved."
PRINT"Output file is ";FIL$;"BCS."
PRINT
PRINT"Want to do another? ";
LOCATE ,,1
I$=INPUT$(1)
IF I$="Y" OR I$="y" THEN 10
END
1600 IF LA$="" THEN LA$=A$: A$="": RETURN
L=LEN(STR$(VAL(A$)))+1
IF INSTR(LA$,"REM") OR INSTR(LA$,"'") THEN 1620
IF INSTR(LA$,"DATA ") OR INSTR(LA$,"IF ") THEN 1620
IF LEN(LA$)+LEN(A$)-L>230 THEN 1620
A$=MID$(A$,L)
IF LEFT$(A$,1)="'" THEN LA$=LA$+A$: BYT=BYT+5 _
ELSE LA$=LA$+":"+A$: BYT=BYT+4
A$=""
RETURN
1620 IF LA$<>"" THEN PRINT#2,LA$
LA$=A$
A$=""
RETURN